(* =============================================================================
         SX-Plugin System (previously GSPlugin)
         by TSX Software, 2011
   -----------------------------------------------------------------------------
     File: GSDLLTexCommon.pas

     Set of common exported functions for Image Plugin.
   -----------------------------------------------------------------------------
    Copyright (c) 2011, TSX Software

    License: New BSD license (see 'LICENSE' file)
   ============================================================================= *)
unit GSDLLTexCommon;

interface

uses
  Classes, GSPluginIntf, RGSTextureStorage;

procedure textureClose(ptr: Pointer); stdcall; export;
function textureInfo(ptr: Pointer; infoPtr: PGSImageInfo): boolean; stdcall; export;
function textureGetBits(ptr: Pointer; mip: byte; data: PByte): cardinal; stdcall; export;
function textureSave(ptr: pointer; memory: boolean; data: pointer; var dwDataSize: cardinal): Pointer; stdcall; export;
function textureSetBits(ptr: Pointer; data: PByte; dwdataSize: cardinal): cardinal; stdcall; export;
function textureSetMipBits(ptr: Pointer; mip: byte; data: PByte; dwdataSize: cardinal): cardinal; stdcall; export;

implementation

uses SysUtils;

procedure textureClose(ptr: Pointer); stdcall; export;
begin
  TRGSTextureStorage(ptr).Free;
  ptr := nil;
end;

function textureInfo(ptr: Pointer; infoPtr: PGSImageInfo): boolean; stdcall; export;
begin
  try
    with TRGSTextureStorage(ptr),infoPtr^ do begin
      wWidth := Width;
      wHeight := Height;
      wDepth := Depth;
      kFormat := TexFormat;
      bMipLevels := MipLevels.bCount;
      bCubeMap := IsCubeMap;
    end;
    result := true;
  except result := false; end;
end;

function textureGetBits(ptr: Pointer; mip: byte; data: PByte): cardinal; stdcall; export;
begin
  if not assigned(data) then begin
    // Return needed size in bytes
    with TRGSTextureStorage(ptr) do
      result := MipLevels.aData[mip].FDataSize;
  end else begin
    try
      with TRGSTextureStorage(ptr) do begin
        result := MipLevels.aData[mip].FDataSize;
        move(Pointer(cardinal(FBits) + MipLevels.aData[mip].dwPos)^, data^, result);
      end;
    except
      result := 0;
    end;
  end;
end;

function textureSave(ptr: pointer; memory: boolean; data: pointer; var dwDataSize: cardinal): Pointer; stdcall; export;
var ms: TMemoryStream;
begin
  Result := nil;
  with TRGSTextureStorage(ptr) do
    if memory then begin
      Result := Data;
      ms := TMemoryStream.Create;
      try
        SaveToStream(ms);
        if (ms.Size > dwDataSize) then
          ReallocMem(Result, ms.Size);
        dwDataSize := ms.Size;
        ms.Position := 0;
        ms.Read(Result^, dwDataSize);
      finally ms.Free; end;
    end else
      SaveToFile(strPas(pchar(data)));
end;

function textureSetBits(ptr: Pointer; data: PByte; dwdataSize: cardinal): cardinal; stdcall; export;
begin
  Result := 0;
  with TRGSTextureStorage(ptr) do
    move(data^, fbits^, dataSize);
  result := dwdataSize;
end;

function textureSetMipBits(ptr: Pointer; mip: byte; data: PByte; dwdataSize: cardinal): cardinal; stdcall; export;
var lData:PGSPixelQuad;
begin
  Result := 0;
  with TRGSTextureStorage(ptr) do begin
    lData := FBits;
    // seek
    inc(lData, MipLevels.aData[mip].dwPos);
    if dwdataSize>MipLevels.aData[mip].FDataSize then
      dwdataSize := MipLevels.aData[mip].FDataSize;
    // write
    move(data^, lData^, dwdataSize);
  end;
  result := dwdataSize;
end;

end.
